home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / src / normalar.c < prev    next >
Text File  |  1994-01-03  |  25KB  |  1,175 lines
  1. # include "NormalAr.h"
  2. # include "yyNArray.w"
  3. # include <stdio.h>
  4. # if defined __STDC__ | defined __cplusplus
  5. #  include <stdlib.h>
  6. # else
  7.    extern void exit ();
  8. # endif
  9. # include "Tree.h"
  10. # include "Definiti.h"
  11.  
  12. # ifndef NULL
  13. # define NULL 0L
  14. # endif
  15. # ifndef false
  16. # define false 0
  17. # endif
  18. # ifndef true
  19. # define true 1
  20. # endif
  21.  
  22. # ifdef yyInline
  23. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) \
  24.   if ((ptr = (tree) free) >= (tree) max) ptr = alloc (); \
  25.   free += nodesize [kind]; \
  26.   ptr->yyHead.yyMark = 0; \
  27.   ptr->Kind = kind;
  28. # else
  29. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) ptr = make (kind);
  30. # endif
  31.  
  32. # define yyWrite(s) (void) fputs (s, yyf)
  33. # define yyWriteNl (void) fputc ('\n', yyf)
  34.  
  35. # line 29 "NormalArrays.puma"
  36.  
  37.  
  38. # include "Idents.h"
  39. # include "StringMe.h"
  40.  
  41. # include "protocol.h"
  42.  
  43. # include "Expressi.h"   /* AddConstant     */
  44. # include "Shapes.h"        /* GetCurrentShape */
  45.  
  46. # include "Globals.h"       /* SplitSet, SplitGet */
  47.  
  48. bool has_changed;           /* required to protocol only changes */
  49.  
  50.  
  51.  
  52. static FILE * yyf = stdout;
  53.  
  54. static void yyAbort
  55. # ifdef __cplusplus
  56.  (char * yyFunction)
  57. # else
  58.  (yyFunction) char * yyFunction;
  59. # endif
  60. {
  61.  (void) fprintf (stderr, "Error: module NormalArrays, routine %s failed\n", yyFunction);
  62.  exit (1);
  63. }
  64.  
  65. void NormalArrays ARGS((tTree t));
  66. static void NormalDeclArrays ARGS((tTree decls));
  67. static void NormalizeDimensions ARGS((tTree indextypes));
  68. static void NormalACFArrays ARGS((tTree t));
  69. static void NormalStmtArrays ARGS((tTree t));
  70. static void NormalParamArrays ARGS((tTree t));
  71. static void NormalExpArrays ARGS((tTree t));
  72. static void NormalAllocArrays ARGS((tTree t));
  73. static void NormalizeAllocDimensions ARGS((tTree indextypes));
  74. static void NormalArrayIndexes ARGS((tTree indexes, shape s, int n));
  75. static tTree NormalizeDimExp ARGS((tTree exp, tTree lb));
  76. static void NormalIntrSubroutine ARGS((tIdent name, tTree params));
  77. static bool IsNormal ARGS((tTree lb));
  78.  
  79. void NormalArrays
  80. # if defined __STDC__ | defined __cplusplus
  81. (register tTree t)
  82. # else
  83. (t)
  84.  register tTree t;
  85. # endif
  86. {
  87.   if (t == NoTree) return;
  88.   if (t->Kind == kBODY_NODE) {
  89.   if (t->BODY_NODE.INTERNALS->Kind == kDECL_EMPTY) {
  90. # line 56 "NormalArrays.puma"
  91.   {
  92. # line 57 "NormalArrays.puma"
  93.    NormalACFArrays (t->BODY_NODE.STATS);
  94. # line 58 "NormalArrays.puma"
  95.    NormalDeclArrays (t->BODY_NODE.DECLS);
  96. # line 59 "NormalArrays.puma"
  97.    NormalAllocArrays (t->BODY_NODE.STATS);
  98.   }
  99.    return;
  100.  
  101.   }
  102.   }
  103. ;
  104. }
  105.  
  106. static void NormalDeclArrays
  107. # if defined __STDC__ | defined __cplusplus
  108. (register tTree decls)
  109. # else
  110. (decls)
  111.  register tTree decls;
  112. # endif
  113. {
  114.   if (decls == NoTree) return;
  115.   if (decls->Kind == kDECL_EMPTY) {
  116. # line 70 "NormalArrays.puma"
  117.    return;
  118.  
  119.   }
  120.   if (decls->Kind == kDECL_LIST) {
  121. # line 73 "NormalArrays.puma"
  122.   {
  123. # line 74 "NormalArrays.puma"
  124.    NormalDeclArrays (decls->DECL_LIST.Elem);
  125. # line 75 "NormalArrays.puma"
  126.    NormalDeclArrays (decls->DECL_LIST.Next);
  127.   }
  128.    return;
  129.  
  130.   }
  131.   if (decls->Kind == kVAR_DECL) {
  132.   if (decls->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  133. # line 78 "NormalArrays.puma"
  134.   {
  135. # line 80 "NormalArrays.puma"
  136.  has_changed = false;
  137.       NormalizeDimensions (decls->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES);
  138.       if (has_changed)
  139.          tree_protocol ("new array declaration : \n", decls);
  140.  
  141.   }
  142.    return;
  143.  
  144.   }
  145.   }
  146. ;
  147. }
  148.  
  149. static void NormalizeDimensions
  150. # if defined __STDC__ | defined __cplusplus
  151. (register tTree indextypes)
  152. # else
  153. (indextypes)
  154.  register tTree indextypes;
  155. # endif
  156. {
  157.   if (indextypes == NoTree) return;
  158.   if (indextypes->Kind == kTYPE_LIST) {
  159. # line 95 "NormalArrays.puma"
  160.   {
  161. # line 96 "NormalArrays.puma"
  162.    NormalizeDimensions (indextypes->TYPE_LIST.Elem);
  163. # line 97 "NormalArrays.puma"
  164.    NormalizeDimensions (indextypes->TYPE_LIST.Next);
  165.   }
  166.    return;
  167.  
  168.   }
  169.   if (indextypes->Kind == kTYPE_EMPTY) {
  170. # line 100 "NormalArrays.puma"
  171.    return;
  172.  
  173.   }
  174.   if (indextypes->Kind == kINDEX_TYPE) {
  175. # line 105 "NormalArrays.puma"
  176.  {
  177.   bool found;
  178.   int val;
  179.   {
  180. # line 107 "NormalArrays.puma"
  181.  
  182. # line 108 "NormalArrays.puma"
  183.  
  184. # line 110 "NormalArrays.puma"
  185.  GetIntConstValue (indextypes->INDEX_TYPE.LOWER, &found, &val);
  186. # line 112 "NormalArrays.puma"
  187.    if (! ((found == true))) goto yyL3;
  188.   {
  189. # line 113 "NormalArrays.puma"
  190.    if (! ((val == 1))) goto yyL3;
  191.   }
  192.   }
  193.    return;
  194.  }
  195. yyL3:;
  196.  
  197. # line 117 "NormalArrays.puma"
  198.   {
  199. # line 118 "NormalArrays.puma"
  200.  indextypes->INDEX_TYPE.UPPER = NormalizeDimExp (indextypes->INDEX_TYPE.UPPER, indextypes->INDEX_TYPE.LOWER);
  201.       indextypes->INDEX_TYPE.LOWER = mCONST_EXP(mINT_CONSTANT (1));
  202.       has_changed = true;
  203.  
  204.   }
  205.    return;
  206.  
  207.   }
  208.   if (indextypes->Kind == kDYNAMIC) {
  209. # line 126 "NormalArrays.puma"
  210.   {
  211. # line 127 "NormalArrays.puma"
  212.    if (! ((indextypes->DYNAMIC.Shape == NoTree))) goto yyL5;
  213.   }
  214.    return;
  215. yyL5:;
  216.  
  217. # line 130 "NormalArrays.puma"
  218.   {
  219. # line 131 "NormalArrays.puma"
  220.    printf ("NormalizeDimensions: expression (!= NoTree) in DYNAMIC\n");
  221. # line 132 "NormalArrays.puma"
  222.    kill_in_protocol ();
  223.   }
  224.    return;
  225.  
  226.   }
  227. ;
  228. }
  229.  
  230. static void NormalACFArrays
  231. # if defined __STDC__ | defined __cplusplus
  232. (register tTree t)
  233. # else
  234. (t)
  235.  register tTree t;
  236. # endif
  237. {
  238.   if (t == NoTree) return;
  239.  
  240.   switch (t->Kind) {
  241.   case kACF_LIST:
  242. # line 143 "NormalArrays.puma"
  243.   {
  244. # line 144 "NormalArrays.puma"
  245.    set_protocol_stmt (t->ACF_LIST.Elem);
  246. # line 145 "NormalArrays.puma"
  247.    NormalACFArrays (t->ACF_LIST.Elem);
  248. # line 146 "NormalArrays.puma"
  249.    NormalACFArrays (t->ACF_LIST.Next);
  250.   }
  251.    return;
  252.  
  253.   case kACF_EMPTY:
  254. # line 149 "NormalArrays.puma"
  255.    return;
  256.  
  257.   case kACF_DUMMY:
  258. # line 152 "NormalArrays.puma"
  259.    return;
  260.  
  261.   case kACF_BASIC:
  262. # line 155 "NormalArrays.puma"
  263.   {
  264. # line 156 "NormalArrays.puma"
  265.    NormalStmtArrays (t->ACF_BASIC.BASIC_STMT);
  266.   }
  267.    return;
  268.  
  269.   case kACF_IF:
  270. # line 159 "NormalArrays.puma"
  271.   {
  272. # line 160 "NormalArrays.puma"
  273.    NormalExpArrays (t->ACF_IF.IF_EXP);
  274. # line 161 "NormalArrays.puma"
  275.    NormalACFArrays (t->ACF_IF.THEN_PART);
  276. # line 162 "NormalArrays.puma"
  277.    NormalACFArrays (t->ACF_IF.ELSE_PART);
  278.   }
  279.    return;
  280.  
  281.   case kACF_WHERE:
  282. # line 165 "NormalArrays.puma"
  283.   {
  284. # line 167 "NormalArrays.puma"
  285.    NormalExpArrays (t->ACF_WHERE.WHERE_EXP);
  286. # line 168 "NormalArrays.puma"
  287.    NormalACFArrays (t->ACF_WHERE.TRUE_PART);
  288. # line 169 "NormalArrays.puma"
  289.    NormalACFArrays (t->ACF_WHERE.FALSE_PART);
  290.   }
  291.    return;
  292.  
  293.   case kACF_CASE:
  294. # line 172 "NormalArrays.puma"
  295.   {
  296. # line 173 "NormalArrays.puma"
  297.    NormalExpArrays (t->ACF_CASE.CASE_EXP);
  298. # line 174 "NormalArrays.puma"
  299.    NormalACFArrays (t->ACF_CASE.CASE_ALTS);
  300. # line 175 "NormalArrays.puma"
  301.    NormalACFArrays (t->ACF_CASE.CASE_OTHERWISE);
  302.   }
  303.    return;
  304.  
  305.   case kSELECTED_ACF_LIST:
  306. # line 178 "NormalArrays.puma"
  307.   {
  308. # line 179 "NormalArrays.puma"
  309.    NormalACFArrays (t->SELECTED_ACF_LIST.Elem);
  310. # line 180 "NormalArrays.puma"
  311.    NormalACFArrays (t->SELECTED_ACF_LIST.Next);
  312.   }
  313.    return;
  314.  
  315.   case kSELECTED_ACF_EMPTY:
  316. # line 183 "NormalArrays.puma"
  317.    return;
  318.  
  319.   case kSELECTED_ACF_NODE:
  320. # line 186 "NormalArrays.puma"
  321.   {
  322. # line 187 "NormalArrays.puma"
  323.    NormalExpArrays (t->SELECTED_ACF_NODE.SELECT_LIST);
  324. # line 188 "NormalArrays.puma"
  325.    NormalACFArrays (t->SELECTED_ACF_NODE.SELECT_ACFS);
  326.   }
  327.    return;
  328.  
  329.   case kACF_WHILE:
  330. # line 191 "NormalArrays.puma"
  331.   {
  332. # line 192 "NormalArrays.puma"
  333.    NormalExpArrays (t->ACF_WHILE.WHILE_EXP);
  334. # line 193 "NormalArrays.puma"
  335.    NormalACFArrays (t->ACF_WHILE.WHILE_BODY);
  336.   }
  337.    return;
  338.  
  339.   case kACF_FORALL:
  340. # line 196 "NormalArrays.puma"
  341.   {
  342. # line 197 "NormalArrays.puma"
  343.    NormalExpArrays (t->ACF_FORALL.FORALL_RANGE);
  344. # line 198 "NormalArrays.puma"
  345.    NormalACFArrays (t->ACF_FORALL.FORALL_BODY);
  346.   }
  347.    return;
  348.  
  349.   case kACF_DOLOCAL:
  350. # line 201 "NormalArrays.puma"
  351.   {
  352. # line 202 "NormalArrays.puma"
  353.    NormalExpArrays (t->ACF_DOLOCAL.DOLOCAL_RANGE);
  354. # line 203 "NormalArrays.puma"
  355.    NormalACFArrays (t->ACF_DOLOCAL.DOLOCAL_BODY);
  356.   }
  357.    return;
  358.  
  359.   case kACF_DO:
  360. # line 206 "NormalArrays.puma"
  361.   {
  362. # line 207 "NormalArrays.puma"
  363.    NormalExpArrays (t->ACF_DO.DO_RANGE);
  364. # line 208 "NormalArrays.puma"
  365.    NormalACFArrays (t->ACF_DO.DO_BODY);
  366.   }
  367.    return;
  368.  
  369.   }
  370.  
  371. # line 211 "NormalArrays.puma"
  372.   {
  373. # line 212 "NormalArrays.puma"
  374.    failure_protocol ("NormalArrays", "NormalACFArrays", t);
  375.   }
  376.    return;
  377.  
  378. ;
  379. }
  380.  
  381. static void NormalStmtArrays
  382. # if defined __STDC__ | defined __cplusplus
  383. (register tTree t)
  384. # else
  385. (t)
  386.  register tTree t;
  387. # endif
  388. {
  389.   if (t == NoTree) return;
  390.  
  391.   switch (t->Kind) {
  392.   case kASSIGN_STMT:
  393. # line 223 "NormalArrays.puma"
  394.   {
  395. # line 224 "NormalArrays.puma"
  396.    NormalExpArrays (t->ASSIGN_STMT.ASSIGN_VAR);
  397. # line 225 "NormalArrays.puma"
  398.    NormalExpArrays (t->ASSIGN_STMT.ASSIGN_EXP);
  399.   }
  400.    return;
  401.  
  402.   case kFORMAT_STMT:
  403. # line 228 "NormalArrays.puma"
  404.    return;
  405.  
  406.   case kIO_STMT:
  407. # line 232 "NormalArrays.puma"
  408.   {
  409. # line 233 "NormalArrays.puma"
  410.    NormalParamArrays (t->IO_STMT.IO_ITEMS);
  411.   }
  412.    return;
  413.  
  414.   case kCALL_STMT:
  415. # line 236 "NormalArrays.puma"
  416.   {
  417. # line 238 "NormalArrays.puma"
  418.    if (! (t->CALL_STMT.CALL_ID->PROC_OBJ.Object == GetDeclEntry (t->CALL_STMT.CALL_ID->PROC_OBJ.Ident, GetIntrinsicEntries ()))) goto yyL4;
  419.   {
  420. # line 239 "NormalArrays.puma"
  421.    NormalIntrSubroutine (t->CALL_STMT.CALL_ID->PROC_OBJ.Ident, t->CALL_STMT.CALL_PARAMS);
  422.   }
  423.   }
  424.    return;
  425. yyL4:;
  426.  
  427. # line 242 "NormalArrays.puma"
  428.   {
  429. # line 243 "NormalArrays.puma"
  430.    NormalParamArrays (t->CALL_STMT.CALL_PARAMS);
  431.   }
  432.    return;
  433.  
  434.   case kREDUCE_STMT:
  435. # line 246 "NormalArrays.puma"
  436.   {
  437. # line 247 "NormalArrays.puma"
  438.    NormalParamArrays (t->REDUCE_STMT.RED_PARAMS);
  439.   }
  440.    return;
  441.  
  442.   case kALLOCATE_STMT:
  443. # line 250 "NormalArrays.puma"
  444.   {
  445. # line 251 "NormalArrays.puma"
  446.    NormalExpArrays (t->ALLOCATE_STMT.STAT);
  447. # line 252 "NormalArrays.puma"
  448.    SetAllocateShapes (t->ALLOCATE_STMT.PARAMS);
  449.   }
  450.    return;
  451.  
  452.   case kDEALLOCATE_STMT:
  453. # line 255 "NormalArrays.puma"
  454.   {
  455. # line 256 "NormalArrays.puma"
  456.    NormalExpArrays (t->DEALLOCATE_STMT.STAT);
  457. # line 258 "NormalArrays.puma"
  458.    ResetDeallocateShapes (t->DEALLOCATE_STMT.PARAMS);
  459.   }
  460.    return;
  461.  
  462.   case kGOTO_STMT:
  463. # line 261 "NormalArrays.puma"
  464.    return;
  465.  
  466.   case kCOMP_GOTO_STMT:
  467. # line 264 "NormalArrays.puma"
  468.   {
  469. # line 265 "NormalArrays.puma"
  470.    NormalExpArrays (t->COMP_GOTO_STMT.GOTO_EXP);
  471.   }
  472.    return;
  473.  
  474.   case kCOMP_IF_STMT:
  475. # line 268 "NormalArrays.puma"
  476.   {
  477. # line 269 "NormalArrays.puma"
  478.    NormalExpArrays (t->COMP_IF_STMT.IF_EXP);
  479.   }
  480.    return;
  481.  
  482.   case kSTOP_STMT:
  483. # line 272 "NormalArrays.puma"
  484.   {
  485. # line 273 "NormalArrays.puma"
  486.    NormalExpArrays (t->STOP_STMT.STOP_CONST);
  487.   }
  488.    return;
  489.  
  490.   case kRETURN_STMT:
  491. # line 276 "NormalArrays.puma"
  492.   {
  493. # line 277 "NormalArrays.puma"
  494.    NormalExpArrays (t->RETURN_STMT.RETURN_EXP);
  495.   }
  496.    return;
  497.  
  498.   }
  499.  
  500. # line 280 "NormalArrays.puma"
  501.   {
  502. # line 281 "NormalArrays.puma"
  503.    failure_protocol ("NormalArrays", "NormalStmtArrays", t);
  504.   }
  505.    return;
  506.  
  507. ;
  508. }
  509.  
  510. static void NormalParamArrays
  511. # if defined __STDC__ | defined __cplusplus
  512. (register tTree t)
  513. # else
  514. (t)
  515.  register tTree t;
  516. # endif
  517. {
  518.   if (t == NoTree) return;
  519.   if (t->Kind == kBTP_LIST) {
  520. # line 286 "NormalArrays.puma"
  521.   {
  522. # line 287 "NormalArrays.puma"
  523.    NormalParamArrays (t->BTP_LIST.Elem);
  524. # line 288 "NormalArrays.puma"
  525.    NormalParamArrays (t->BTP_LIST.Next);
  526.   }
  527.    return;
  528.  
  529.   }
  530.   if (t->Kind == kBTP_EMPTY) {
  531. # line 291 "NormalArrays.puma"
  532.    return;
  533.  
  534.   }
  535.   if (t->Kind == kVAR_PARAM) {
  536. # line 294 "NormalArrays.puma"
  537.   {
  538. # line 295 "NormalArrays.puma"
  539.    NormalExpArrays (t->VAR_PARAM.V);
  540.   }
  541.    return;
  542.  
  543.   }
  544.   if (t->Kind == kFUNC_PARAM) {
  545. # line 298 "NormalArrays.puma"
  546.    return;
  547.  
  548.   }
  549.   if (t->Kind == kPROC_PARAM) {
  550. # line 301 "NormalArrays.puma"
  551.    return;
  552.  
  553.   }
  554. # line 304 "NormalArrays.puma"
  555.   {
  556. # line 305 "NormalArrays.puma"
  557.    failure_protocol ("NormalArrays", "NormalParamArrays", t);
  558.   }
  559.    return;
  560.  
  561. ;
  562. }
  563.  
  564. static void NormalExpArrays
  565. # if defined __STDC__ | defined __cplusplus
  566. (register tTree t)
  567. # else
  568. (t)
  569.  register tTree t;
  570. # endif
  571. {
  572.   if (t == NoTree) return;
  573.  
  574.   switch (t->Kind) {
  575.   case kBTE_LIST:
  576. # line 319 "NormalArrays.puma"
  577.   {
  578. # line 320 "NormalArrays.puma"
  579.    NormalExpArrays (t->BTE_LIST.Elem);
  580. # line 321 "NormalArrays.puma"
  581.    NormalExpArrays (t->BTE_LIST.Next);
  582.   }
  583.    return;
  584.  
  585.   case kBTE_EMPTY:
  586. # line 324 "NormalArrays.puma"
  587.    return;
  588.  
  589.   case kDUMMY_VAR:
  590. # line 327 "NormalArrays.puma"
  591.    return;
  592.  
  593.   case kUSED_VAR:
  594. # line 330 "NormalArrays.puma"
  595.    return;
  596.  
  597.   case kLOOP_VAR:
  598. # line 333 "NormalArrays.puma"
  599.    return;
  600.  
  601.   case kSUBSTRING_VAR:
  602. # line 336 "NormalArrays.puma"
  603.   {
  604. # line 337 "NormalArrays.puma"
  605.    NormalExpArrays (t->SUBSTRING_VAR.IND_VAR);
  606. # line 338 "NormalArrays.puma"
  607.    NormalExpArrays (t->SUBSTRING_VAR.IND_EXP);
  608.   }
  609.    return;
  610.  
  611.   case kINDEXED_VAR:
  612. # line 344 "NormalArrays.puma"
  613.  {
  614.   struct_shape s;
  615.   {
  616. # line 346 "NormalArrays.puma"
  617.    NormalExpArrays (t->INDEXED_VAR.IND_EXPS);
  618. # line 348 "NormalArrays.puma"
  619.  
  620. # line 350 "NormalArrays.puma"
  621.  GetCurrentShape (t->INDEXED_VAR.IND_VAR, &s);
  622.       NormalArrayIndexes (t->INDEXED_VAR.IND_EXPS, &s, 0);
  623.  
  624.   }
  625.    return;
  626.  }
  627.  
  628.   case kDO_VAR:
  629. # line 355 "NormalArrays.puma"
  630.   {
  631. # line 356 "NormalArrays.puma"
  632.    NormalExpArrays (t->DO_VAR.RANGE);
  633. # line 357 "NormalArrays.puma"
  634.    NormalExpArrays (t->DO_VAR.BODY);
  635.   }
  636.    return;
  637.  
  638.   case kBTV_LIST:
  639. # line 360 "NormalArrays.puma"
  640.   {
  641. # line 361 "NormalArrays.puma"
  642.    NormalExpArrays (t->BTV_LIST.Elem);
  643. # line 362 "NormalArrays.puma"
  644.    NormalExpArrays (t->BTV_LIST.Next);
  645.   }
  646.    return;
  647.  
  648.   case kBTV_EMPTY:
  649. # line 365 "NormalArrays.puma"
  650.    return;
  651.  
  652.   case kADDR:
  653. # line 368 "NormalArrays.puma"
  654.   {
  655. # line 369 "NormalArrays.puma"
  656.    NormalExpArrays (t->ADDR.E);
  657.   }
  658.    return;
  659.  
  660.   case kDUMMY_EXP:
  661. # line 372 "NormalArrays.puma"
  662.    return;
  663.  
  664.   case kCONST_EXP:
  665. # line 375 "NormalArrays.puma"
  666.    return;
  667.  
  668.   case kARRAY_EXP:
  669. # line 378 "NormalArrays.puma"
  670.   {
  671. # line 379 "NormalArrays.puma"
  672.    NormalExpArrays (t->ARRAY_EXP.ELEMENTS);
  673.   }
  674.    return;
  675.  
  676.   case kSLICE_EXP:
  677. # line 382 "NormalArrays.puma"
  678.   {
  679. # line 383 "NormalArrays.puma"
  680.    NormalExpArrays (t->SLICE_EXP.START);
  681. # line 384 "NormalArrays.puma"
  682.    NormalExpArrays (t->SLICE_EXP.STOP);
  683. # line 385 "NormalArrays.puma"
  684.    NormalExpArrays (t->SLICE_EXP.INC);
  685.   }
  686.    return;
  687.  
  688.   case kOP_EXP:
  689. # line 388 "NormalArrays.puma"
  690.   {
  691. # line 390 "NormalArrays.puma"
  692.    NormalExpArrays (t->OP_EXP.OPND1);
  693. # line 391 "NormalArrays.puma"
  694.    NormalExpArrays (t->OP_EXP.OPND2);
  695.   }
  696.    return;
  697.  
  698.   case kOP1_EXP:
  699. # line 394 "NormalArrays.puma"
  700.   {
  701. # line 395 "NormalArrays.puma"
  702.    NormalExpArrays (t->OP1_EXP.OPND);
  703.   }
  704.    return;
  705.  
  706.   case kVAR_EXP:
  707. # line 398 "NormalArrays.puma"
  708.   {
  709. # line 399 "NormalArrays.puma"
  710.    NormalExpArrays (t->VAR_EXP.V);
  711.   }
  712.    return;
  713.  
  714.   case kFUNC_CALL_EXP:
  715. # line 402 "NormalArrays.puma"
  716.   {
  717. # line 404 "NormalArrays.puma"
  718.    NormalParamArrays (t->FUNC_CALL_EXP.FUNC_PARAMS);
  719.   }
  720.    return;
  721.  
  722.   case kDO_EXP:
  723. # line 407 "NormalArrays.puma"
  724.   {
  725. # line 408 "NormalArrays.puma"
  726.    NormalExpArrays (t->DO_EXP.RANGE);
  727. # line 409 "NormalArrays.puma"
  728.    NormalExpArrays (t->DO_EXP.BODY);
  729.   }
  730.    return;
  731.  
  732.   case kVAR_PARAM:
  733. # line 412 "NormalArrays.puma"
  734.   {
  735. # line 413 "NormalArrays.puma"
  736.    NormalExpArrays (t->VAR_PARAM.V);
  737.   }
  738.    return;
  739.  
  740.   }
  741.  
  742. # line 416 "NormalArrays.puma"
  743.   {
  744. # line 417 "NormalArrays.puma"
  745.    failure_protocol ("NormalArrays", "NormalExpArrays", t);
  746.   }
  747.    return;
  748.  
  749. ;
  750. }
  751.  
  752. static void NormalAllocArrays
  753. # if defined __STDC__ | defined __cplusplus
  754. (register tTree t)
  755. # else
  756. (t)
  757.  register tTree t;
  758. # endif
  759. {
  760.   if (t == NoTree) return;
  761.  
  762.   switch (t->Kind) {
  763.   case kACF_LIST:
  764. # line 428 "NormalArrays.puma"
  765.   {
  766. # line 429 "NormalArrays.puma"
  767.    set_protocol_stmt (t->ACF_LIST.Elem);
  768. # line 430 "NormalArrays.puma"
  769.    NormalAllocArrays (t->ACF_LIST.Elem);
  770. # line 431 "NormalArrays.puma"
  771.    NormalAllocArrays (t->ACF_LIST.Next);
  772.   }
  773.    return;
  774.  
  775.   case kACF_EMPTY:
  776. # line 434 "NormalArrays.puma"
  777.    return;
  778.  
  779.   case kACF_DUMMY:
  780. # line 437 "NormalArrays.puma"
  781.    return;
  782.  
  783.   case kACF_BASIC:
  784.   if (t->ACF_BASIC.BASIC_STMT->Kind == kALLOCATE_STMT) {
  785. # line 440 "NormalArrays.puma"
  786.   {
  787. # line 441 "NormalArrays.puma"
  788.  has_changed = false;
  789.      NormalAllocArrays (t->ACF_BASIC.BASIC_STMT->ALLOCATE_STMT.PARAMS);
  790.      if (has_changed)
  791.        stmt_protocol ("this is the new allocate statementn");
  792.  
  793.   }
  794.    return;
  795.  
  796.   }
  797. # line 448 "NormalArrays.puma"
  798.    return;
  799.  
  800.   case kACF_IF:
  801. # line 451 "NormalArrays.puma"
  802.   {
  803. # line 452 "NormalArrays.puma"
  804.    NormalAllocArrays (t->ACF_IF.THEN_PART);
  805. # line 453 "NormalArrays.puma"
  806.    NormalAllocArrays (t->ACF_IF.ELSE_PART);
  807.   }
  808.    return;
  809.  
  810.   case kACF_WHERE:
  811. # line 456 "NormalArrays.puma"
  812.   {
  813. # line 457 "NormalArrays.puma"
  814.    NormalAllocArrays (t->ACF_WHERE.TRUE_PART);
  815. # line 458 "NormalArrays.puma"
  816.    NormalAllocArrays (t->ACF_WHERE.FALSE_PART);
  817.   }
  818.    return;
  819.  
  820.   case kACF_CASE:
  821. # line 461 "NormalArrays.puma"
  822.   {
  823. # line 462 "NormalArrays.puma"
  824.    NormalAllocArrays (t->ACF_CASE.CASE_ALTS);
  825. # line 463 "NormalArrays.puma"
  826.    NormalAllocArrays (t->ACF_CASE.CASE_OTHERWISE);
  827.   }
  828.    return;
  829.  
  830.   case kSELECTED_ACF_LIST:
  831. # line 466 "NormalArrays.puma"
  832.   {
  833. # line 467 "NormalArrays.puma"
  834.    NormalAllocArrays (t->SELECTED_ACF_LIST.Elem);
  835. # line 468 "NormalArrays.puma"
  836.    NormalAllocArrays (t->SELECTED_ACF_LIST.Next);
  837.   }
  838.    return;
  839.  
  840.   case kSELECTED_ACF_EMPTY:
  841. # line 471 "NormalArrays.puma"
  842.    return;
  843.  
  844.   case kSELECTED_ACF_NODE:
  845. # line 474 "NormalArrays.puma"
  846.   {
  847. # line 475 "NormalArrays.puma"
  848.    NormalAllocArrays (t->SELECTED_ACF_NODE.SELECT_ACFS);
  849.   }
  850.    return;
  851.  
  852.   case kACF_WHILE:
  853. # line 478 "NormalArrays.puma"
  854.   {
  855. # line 479 "NormalArrays.puma"
  856.    NormalAllocArrays (t->ACF_WHILE.WHILE_BODY);
  857.   }
  858.    return;
  859.  
  860.   case kACF_FORALL:
  861. # line 482 "NormalArrays.puma"
  862.   {
  863. # line 483 "NormalArrays.puma"
  864.    NormalAllocArrays (t->ACF_FORALL.FORALL_BODY);
  865.   }
  866.    return;
  867.  
  868.   case kACF_DOLOCAL:
  869. # line 486 "NormalArrays.puma"
  870.   {
  871. # line 487 "NormalArrays.puma"
  872.    NormalAllocArrays (t->ACF_DOLOCAL.DOLOCAL_BODY);
  873.   }
  874.    return;
  875.  
  876.   case kACF_DO:
  877. # line 490 "NormalArrays.puma"
  878.   {
  879. # line 491 "NormalArrays.puma"
  880.    NormalAllocArrays (t->ACF_DO.DO_BODY);
  881.   }
  882.    return;
  883.  
  884.   case kBTP_LIST:
  885. # line 494 "NormalArrays.puma"
  886.   {
  887. # line 495 "NormalArrays.puma"
  888.    NormalAllocArrays (t->BTP_LIST.Elem);
  889. # line 496 "NormalArrays.puma"
  890.    NormalAllocArrays (t->BTP_LIST.Next);
  891.   }
  892.    return;
  893.  
  894.   case kBTP_EMPTY:
  895. # line 499 "NormalArrays.puma"
  896.    return;
  897.  
  898.   case kVAR_PARAM:
  899.   if (t->VAR_PARAM.V->Kind == kINDEXED_VAR) {
  900. # line 502 "NormalArrays.puma"
  901.   {
  902. # line 503 "NormalArrays.puma"
  903.    NormalizeAllocDimensions (t->VAR_PARAM.V->INDEXED_VAR.IND_EXPS);
  904.   }
  905.    return;
  906.  
  907.   }
  908.   break;
  909.   }
  910.  
  911. # line 506 "NormalArrays.puma"
  912.   {
  913. # line 507 "NormalArrays.puma"
  914.    failure_protocol ("NormalArrays", "NormalAllocArrays", t);
  915.   }
  916.    return;
  917.  
  918. ;
  919. }
  920.  
  921. static void NormalizeAllocDimensions
  922. # if defined __STDC__ | defined __cplusplus
  923. (register tTree indextypes)
  924. # else
  925. (indextypes)
  926.  register tTree indextypes;
  927. # endif
  928. {
  929.   if (indextypes == NoTree) return;
  930.   if (indextypes->Kind == kBTE_LIST) {
  931. # line 512 "NormalArrays.puma"
  932.   {
  933. # line 513 "NormalArrays.puma"
  934.    NormalizeAllocDimensions (indextypes->BTE_LIST.Elem);
  935. # line 514 "NormalArrays.puma"
  936.    NormalizeAllocDimensions (indextypes->BTE_LIST.Next);
  937.   }
  938.    return;
  939.  
  940.   }
  941.   if (indextypes->Kind == kBTE_EMPTY) {
  942. # line 517 "NormalArrays.puma"
  943.    return;
  944.  
  945.   }
  946.   if (indextypes->Kind == kSLICE_EXP) {
  947.   if (indextypes->SLICE_EXP.START->Kind == kCONST_EXP) {
  948.   if (indextypes->SLICE_EXP.START->CONST_EXP.C->Kind == kINT_CONSTANT) {
  949.   if (equalint (indextypes->SLICE_EXP.START->CONST_EXP.C->INT_CONSTANT.value, 1)) {
  950. # line 521 "NormalArrays.puma"
  951.    return;
  952.  
  953.   }
  954.   }
  955.   }
  956. # line 525 "NormalArrays.puma"
  957.   {
  958. # line 526 "NormalArrays.puma"
  959.  indextypes->SLICE_EXP.STOP = NormalizeDimExp (indextypes->SLICE_EXP.STOP, indextypes->SLICE_EXP.START);
  960.       indextypes->SLICE_EXP.START = mCONST_EXP(mINT_CONSTANT (1));
  961.       has_changed = true;
  962.  
  963.   }
  964.    return;
  965.  
  966.   }
  967. ;
  968. }
  969.  
  970. static void NormalArrayIndexes
  971. # if defined __STDC__ | defined __cplusplus
  972. (register tTree indexes, shape s, register int n)
  973. # else
  974. (indexes, s, n)
  975.  register tTree indexes;
  976.  shape s;
  977.  register int n;
  978. # endif
  979. {
  980.   if (indexes == NoTree) return;
  981.   if (indexes->Kind == kBTE_LIST) {
  982.   if (indexes->BTE_LIST.Elem->Kind == kSLICE_EXP) {
  983. # line 542 "NormalArrays.puma"
  984.   {
  985. # line 543 "NormalArrays.puma"
  986.  indexes->BTE_LIST.Elem->SLICE_EXP.START = NormalizeDimExp (indexes->BTE_LIST.Elem->SLICE_EXP.START, s->bounds[n][0]);
  987.      indexes->BTE_LIST.Elem->SLICE_EXP.STOP  = NormalizeDimExp (indexes->BTE_LIST.Elem->SLICE_EXP.STOP,  s->bounds[n][0]);
  988.  
  989. # line 546 "NormalArrays.puma"
  990.    NormalArrayIndexes (indexes->BTE_LIST.Next, s, n + 1);
  991.   }
  992.    return;
  993.  
  994.   }
  995. # line 549 "NormalArrays.puma"
  996.   {
  997. # line 550 "NormalArrays.puma"
  998.  indexes->BTE_LIST.Elem = NormalizeDimExp (indexes->BTE_LIST.Elem, s->bounds[n][0]);
  999. # line 551 "NormalArrays.puma"
  1000.    NormalArrayIndexes (indexes->BTE_LIST.Next, s, n + 1);
  1001.   }
  1002.    return;
  1003.  
  1004.   }
  1005.   if (indexes->Kind == kBTE_EMPTY) {
  1006. # line 554 "NormalArrays.puma"
  1007.    return;
  1008.  
  1009.   }
  1010. # line 557 "NormalArrays.puma"
  1011.   {
  1012. # line 558 "NormalArrays.puma"
  1013.    failure_protocol ("NormalArrays", "NormalArrayIndexes", indexes);
  1014.   }
  1015.    return;
  1016.  
  1017. ;
  1018. }
  1019.  
  1020. static tTree NormalizeDimExp
  1021. # if defined __STDC__ | defined __cplusplus
  1022. (register tTree exp, register tTree lb)
  1023. # else
  1024. (exp, lb)
  1025.  register tTree exp;
  1026.  register tTree lb;
  1027. # endif
  1028. {
  1029.   if (exp->Kind == kDUMMY_EXP) {
  1030. # line 569 "NormalArrays.puma"
  1031.    return exp;
  1032.  
  1033.   }
  1034.   if (lb->Kind == kDUMMY_EXP) {
  1035. # line 573 "NormalArrays.puma"
  1036.    return exp;
  1037.  
  1038.   }
  1039. # line 577 "NormalArrays.puma"
  1040.  {
  1041.   bool found;
  1042.   int val;
  1043.   {
  1044. # line 579 "NormalArrays.puma"
  1045.  
  1046. # line 580 "NormalArrays.puma"
  1047.  
  1048. # line 582 "NormalArrays.puma"
  1049.  GetIntConstValue (lb, &found, &val);
  1050. # line 583 "NormalArrays.puma"
  1051.    if (! (found == true)) goto yyL3;
  1052.   }
  1053.   {
  1054.    return AddConstant (exp, - val + 1);
  1055.   }
  1056.  }
  1057. yyL3:;
  1058.  
  1059. # line 587 "NormalArrays.puma"
  1060.    return AddConstant (mOP_EXP (mOP_MINUS (), exp, lb), 1);
  1061.  
  1062. }
  1063.  
  1064. static void NormalIntrSubroutine
  1065. # if defined __STDC__ | defined __cplusplus
  1066. (register tIdent name, register tTree params)
  1067. # else
  1068. (name, params)
  1069.  register tIdent name;
  1070.  register tTree params;
  1071. # endif
  1072. {
  1073. # line 604 "NormalArrays.puma"
  1074.  
  1075. int rank;
  1076. tTree A, B, M, indexes, op;
  1077. struct_shape s;
  1078. int i;
  1079. bool ok;
  1080.  
  1081.   if (params == NoTree) return;
  1082.   if (equaltIdent (name, MakeIdent ("GLOBAL_GET", 10))) {
  1083. # line 612 "NormalArrays.puma"
  1084.   {
  1085. # line 614 "NormalArrays.puma"
  1086.  SplitGet (params, &rank, &A, &B, &indexes, &M);
  1087.  
  1088.  
  1089.  
  1090.       GetCurrentShape (B, &s);
  1091.  
  1092.       ok = true;
  1093.       for (i=0; i<rank; i++)
  1094.         ok = ok && IsNormal (s.bounds[i][0]);
  1095.  
  1096.       if (!ok)
  1097.          error_protocol ("Indirect accessed array must be normal before");
  1098.  
  1099.   }
  1100.    return;
  1101.  
  1102.   }
  1103.   if (equaltIdent (name, MakeIdent ("GLOBAL_SEND", 11))) {
  1104. # line 629 "NormalArrays.puma"
  1105.   {
  1106. # line 631 "NormalArrays.puma"
  1107.  SplitSend (params, &rank, &A, &B, &indexes, &M, &op);
  1108.  
  1109.  
  1110.  
  1111.       GetCurrentShape (B, &s);
  1112.  
  1113.       ok = true;
  1114.       for (i=0; i<rank; i++)
  1115.         ok = ok && IsNormal (s.bounds[i][0]);
  1116.  
  1117.       if (!ok)
  1118.          error_protocol ("Indirect accessed array must be normal before");
  1119.  
  1120.   }
  1121.    return;
  1122.  
  1123.   }
  1124. # line 646 "NormalArrays.puma"
  1125.   {
  1126. # line 647 "NormalArrays.puma"
  1127.    NormalParamArrays (params);
  1128.   }
  1129.    return;
  1130.  
  1131. ;
  1132. }
  1133.  
  1134. static bool IsNormal
  1135. # if defined __STDC__ | defined __cplusplus
  1136. (register tTree lb)
  1137. # else
  1138. (lb)
  1139.  register tTree lb;
  1140. # endif
  1141. {
  1142.   if (lb == NoTree) return false;
  1143. # line 652 "NormalArrays.puma"
  1144.  {
  1145.   int val;
  1146.   bool found;
  1147.   {
  1148. # line 654 "NormalArrays.puma"
  1149.  
  1150. # line 655 "NormalArrays.puma"
  1151.  
  1152. # line 657 "NormalArrays.puma"
  1153.    GetIntConstValue (lb, & found, & val);
  1154. # line 658 "NormalArrays.puma"
  1155.    if (! ((found == true))) goto yyL1;
  1156.   {
  1157. # line 659 "NormalArrays.puma"
  1158.    if (! ((val == 1))) goto yyL1;
  1159.   }
  1160.   }
  1161.    return true;
  1162.  }
  1163. yyL1:;
  1164.  
  1165.   return false;
  1166. }
  1167.  
  1168. void BeginNormalArrays ()
  1169. {
  1170. }
  1171.  
  1172. void CloseNormalArrays ()
  1173. {
  1174. }
  1175.